home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
Queues
/
PriorityQueue
next >
Wrap
Text File
|
1993-03-29
|
5KB
|
162 lines
unit PriorityQueue;
{This unit implements a priority queue. This is cribbed from "Data Structures and}
{Algorithms", Aho, Hopcroft, and Ullman, Addison-Wesley, 1983 (corrected 1987 edition).}
interface
type
PriorityQueueItem = record
data: Longint;
priority: Longint;
end;
PriorityQueue = record
Qsize, Qlast: Integer;
Qelts: array[1..1] of PriorityQueueItem;
end;
PriorityQueuePtr = ^PriorityQueue;
PriorityQueueHandle = ^PriorityQueuePtr;
procedure NewPriorityQueue (itsSize: Integer;
var theQueue: PriorityQueueHandle);
procedure DisposePriorityQueue (theQueue: PriorityQueueHandle);
procedure FlushPriorityQueue (theQueue: PriorityQueueHandle);
function PriorityQueueFull (theQueue: PriorityQueueHandle): Boolean;
function PriorityQueueEmpty (theQueue: PriorityQueueHandle): Boolean;
procedure PriorityQueueInsert (item: univ Longint;
itemPriority: Longint;
theQueue: PriorityQueueHandle);
procedure PriorityQueueDeleteMin (var item: univ Longint;
var itemPriority: Longint;
theQueue: PriorityQueueHandle);
implementation
{Array implementation of priority queue implements balanced tree as a heap (not to be}
{confused with the Mac's memory space). If we call array A, the root of the tree is at}
{A[1], and for i > 1, the parent of A[i] is A[i div 2]. The priority of a given node is no}
{greater than the priority of both its children.}
{Using a heap rather than a real tree costs us a slight overhead in integer multiplication}
{and division, but saves us a lot of time in creating and deleting nodes. The complexity}
{is O(log n) regardless of representation.}
procedure FlushPriorityQueue (theQueue: PriorityQueueHandle);
begin
theQueue^^.Qlast := 0;
end;
procedure NewPriorityQueue (itsSize: Integer;
var theQueue: PriorityQueueHandle);
begin
theQueue := PriorityQueueHandle(NewHandle(SIZEOF(PriorityQueue) + (itsSize - 1) * SIZEOF(PriorityQueueItem)));
theQueue^^.Qsize := itsSize;
FlushPriorityQueue(theQueue);
end;
procedure DisposePriorityQueue (theQueue: PriorityQueueHandle);
begin
DisposHandle(Handle(theQueue));
end;
function PriorityQueueFull (theQueue: PriorityQueueHandle): Boolean;
begin
with theQueue^^ do
PriorityQueueFull := Qlast = Qsize;
end;
function PriorityQueueEmpty (theQueue: PriorityQueueHandle): Boolean;
begin
PriorityQueueEmpty := theQueue^^.Qlast = 0;
end;
procedure Swap (var a, b: PriorityQueueItem);
var
temp: PriorityQueueItem;
begin
temp := a;
a := b;
b := temp;
end;
procedure PriorityQueueInsert (item: univ Longint;
itemPriority: Longint;
theQueue: PriorityQueueHandle);
var
i: Integer;
begin
if not PriorityQueueFull(theQueue) then
with theQueue^^ do
begin
Qlast := Qlast + 1;
{$PUSH}
{$R-}
with Qelts[Qlast] do {start with new element at bottom left of tree}
{$POP}
begin
data := item;
priority := itemPriority;
end;
i := Qlast;
{$PUSH}
{$R-}
while (i > 1) & (Qelts[i].priority < Qelts[i div 2].priority) do
begin {repeatedly swap the new element with its parent to maintain the invariant}
Swap(Qelts[i], Qelts[i div 2]);
i := i div 2;
end;
{$POP}
end;
end;
procedure PriorityQueueDeleteMin (var item: univ Longint;
var itemPriority: Longint;
theQueue: PriorityQueueHandle);
var
i, j: Integer;
min: PriorityQueueItem;
begin
if not PriorityQueueEmpty(theQueue) then
with theQueue^^ do
begin
with Qelts[1] do {the easy part - minimum is in a known place}
begin
item := data;
itemPriority := priority;
end;
{$PUSH}
{$R-}
Qelts[1] := Qelts[Qlast]; {replace the root with the bottom left element}
{$POP}
Qlast := Qlast - 1;
i := 1; {the old last element is in the wrong place now, so let's track it}
while i <= Qlast div 2 do
begin {push the old last element down the tree to its proper place}
{$PUSH}
{$R-}
if (Qelts[2 * i].priority < Qelts[2 * i + 1].priority) or (2 * i = Qlast) then
{$POP}
j := 2 * i
else
j := 2 * i + 1;
{j is either the child of i having the lower priority,}
{or is last and the only child of i}
{$PUSH}
{$R-}
if Qelts[i].priority > Qelts[j].priority then
begin {swap old last element with its lower priority child…}
Swap(Qelts[i], Qelts[j]);
i := j;
end
else
Leave; {…or, leave if the priority is now correct}
{$POP}
end;
end;
end;
end.